home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / tmodem23.arc / TM2.INC < prev    next >
Encoding:
Text File  |  1985-05-19  |  33.4 KB  |  1,078 lines
  1. (****************************************************************************)
  2. (*                   CHANGE COMMUNICATION PARAMETERS                        *)
  3. (****************************************************************************)
  4.    procedure
  5.       change_comm_params;
  6.    begin
  7.       mkwin(13,7,64,18,'Change Parameters');
  8.       writeln;
  9.       write('    Current Setting: ',baud:4);
  10.       case par of
  11.          0 : write(' N');
  12.          1 : write(' E');
  13.          2 : write(' O');
  14.       end;
  15.       writeln(databits:2,stopbits:2);
  16.       writeln;
  17.       writeln('       Enter New Parameters.');
  18.       writeln('       ---------------------');
  19.       write('    Baud Rate, 300,1200,2400,4800,9600 : ');
  20.       readln(baud_ch);
  21.       if length(baud_ch)>0 then begin
  22.          baud:=bval(baud_ch);
  23.          case baud of
  24.             300  : ;
  25.             1200 : ;
  26.             2400 : ;
  27.             4800 : ;
  28.             9600 : ;
  29.          else
  30.             baud := default_baud;
  31.          end;
  32.       end;
  33.       write('    Parity, (N)one, (E)ven, (O)dd      : ');
  34.       readln(parity_ch);
  35.       if length(parity_ch)>0 then begin
  36.          parity_ch := upcase(parity_ch[1]);
  37.          case parity_ch of
  38.             'N' : par:=0;
  39.             'E' : par:=1;
  40.             'O' : par:=2;
  41.          else
  42.             par:=0;
  43.          end;
  44.       end;
  45.       write('    Data Bits, 7 or 8                  : ');
  46.       readln(data_ch);
  47.       if length(data_ch)>0 then begin
  48.          databits := bval(data_ch);
  49.          case databits of
  50.             7 : ;
  51.             8 : ;
  52.          else
  53.             databits := 8;
  54.          end;
  55.       end;
  56.       write('    Stop Bits, 1 or 2                  : ');
  57.       readln(stop_ch);
  58.       if length(stop_ch)>0 then begin
  59.          stopbits := bval(stop_ch);
  60.          case stopbits of
  61.             1 : ;
  62.             2 : ;
  63.          else
  64.             stopbits := 1;
  65.          end;
  66.       end;
  67.       setserial(baud,stopbits,databits,par);
  68.       rmwin;
  69.    end;
  70.  
  71. (****************************************************************************)
  72. (*                        PAINT DIRECTORY SCREEN                            *)
  73. (****************************************************************************)
  74.    procedure
  75.       paint_directory_screen(en : integer);
  76.    var
  77.       i   : integer;
  78.       row : integer;
  79.       num : integer;
  80.    begin
  81.       for i:=en to max_dial_entries do begin
  82.          row := i + 3;
  83.          num := ( dialarray_number * max_dial_entries ) + i;
  84.          gotoxy(1,row);
  85.          write(num:3,' ');
  86.          clreol;
  87.          with dial_dir do begin
  88.             if i <= no_of_dial_entries then begin
  89.                with dir_entries[i] do begin
  90.                   gotoxy(5,row);
  91.                   write(bbs_name);
  92.                   gotoxy(36,row);
  93.                   write(bbs_number);
  94.                   gotoxy(67,row);
  95.                   write(bbs_baud:4);
  96.                   gotoxy(72,row);
  97.                   case bbs_parity of
  98.                      0 : write('N ');
  99.                      1 : write('E ');
  100.                      2 : write('O ');
  101.                   end;
  102.                   write(bbs_databits,' ',bbs_stopbits);
  103.                end;
  104.             end;
  105.          end;
  106.          writeln;
  107.       end;
  108.    end;
  109.  
  110. (****************************************************************************)
  111. (*                          GET DIRECTORY INFO                              *)
  112. (****************************************************************************)
  113.    procedure
  114.       get_info(i  :  integer);
  115.    var
  116.       entry_no    : integer;
  117.    begin
  118.       entry_no := i - 3;
  119.       with dial_dir.dir_entries[entry_no] do begin
  120.          gotoxy(5,i);
  121.          str_input(bbs_name);
  122.          gotoxy(36,i);
  123.          str_input(bbs_number);
  124.          gotoxy(67,i);
  125.          if bbs_baud = 0 then begin
  126.             baud_ch := '';
  127.             parity_ch := '';
  128.             data_ch := '';
  129.             stop_ch := '';
  130.          end
  131.          else begin
  132.             str(bbs_baud:4,baud_ch);
  133.             case bbs_parity of
  134.                0 : parity_ch := 'N';
  135.                1 : parity_ch := 'E';
  136.                2 : parity_ch := 'O';
  137.             else
  138.                parity_ch := ' ';
  139.             end;
  140.             str(bbs_databits:1,data_ch);
  141.             str(bbs_stopbits:1,stop_ch);
  142.          end;
  143.          str_input(baud_ch);
  144.          bbs_baud := bval(baud_ch);
  145.          case bbs_baud of
  146.             300  : ;
  147.             1200 : ;
  148.             2400 : ;
  149.             4800 : ;
  150.             9600 : ;
  151.          else
  152.             bbs_baud := default_baud;
  153.          end;
  154.          gotoxy(72,i);
  155.          str_input(parity_ch);
  156.          parity_ch := upcase(parity_ch[1]);
  157.          case parity_ch of
  158.             'N' : bbs_parity := 0;
  159.             'E' : bbs_parity := 1;
  160.             'O' : bbs_parity := 2;
  161.          else
  162.             bbs_parity := 0;
  163.          end;
  164.          gotoxy(73,i);
  165.          write(' ');
  166.          str_input(data_ch);
  167.          bbs_databits := bval(data_ch);
  168.          case bbs_databits of
  169.             7 : ;
  170.             8 : ;
  171.          else
  172.             bbs_databits := 8;
  173.          end;
  174.          gotoxy(76,i);
  175.          str_input(stop_ch);
  176.          bbs_stopbits := bval(stop_ch);
  177.          case bbs_stopbits of
  178.             1 : ;
  179.             2 : ;
  180.          else
  181.             bbs_stopbits := 1;
  182.          end;
  183.       end;
  184.    end;
  185.  
  186. (****************************************************************************)
  187. (*                          ADD DIRECTORY ENTRY                             *)
  188. (****************************************************************************)
  189.    procedure
  190.       add_dial_entry;
  191.    var
  192.       row    : integer;
  193.       ch     : char;
  194.    begin
  195.       with dial_dir do begin
  196.          while no_of_dial_entries = max_dial_entries do begin
  197.             dialarray_number := dialarray_number + 1;
  198.             {$I-}
  199.             seek(dialfile,dialarray_number);
  200.             read(dialfile,dial_dir);
  201.             {$I+}
  202.             ok := (ioresult=0);
  203.             if not ok then begin
  204.                seek(dialfile,dialarray_number);
  205.                no_of_dial_entries := 0;
  206.                write(dialfile,dial_dir);
  207.             end;
  208.          end;
  209.          paint_directory_screen(1);
  210.          no_of_dial_entries := no_of_dial_entries + 1;
  211.          row := no_of_dial_entries + 3;
  212.          with dir_entries[no_of_dial_entries] do begin
  213.             bbs_name := '';
  214.             bbs_number := '';
  215.             bbs_baud := 0;
  216.             bbs_parity := 0;
  217.             bbs_databits := 8;
  218.             bbs_stopbits := 1;
  219.          end;
  220.          get_info(row);
  221.          seek(dialfile,dialarray_number);
  222.          write(dialfile,dial_dir);
  223.       end;
  224.    end;
  225.  
  226. (****************************************************************************)
  227. (*                        CHANGE DIRECTORY ENTRY                            *)
  228. (****************************************************************************)
  229.    procedure
  230.       change_dial_entry;
  231.    var
  232.       i   : integer;
  233.       row : integer;
  234.    begin
  235.       mkwin(41,1,71,5,'Update');
  236.       writeln;
  237.       write(' Enter the # to change: ');
  238.       readln(i);
  239.       rmwin;
  240.       i := i - (dialarray_number * max_dial_entries);
  241.       if ( i > 0 ) and ( i <= max_dial_entries ) then begin
  242.          row := i + 3;
  243.          get_info(row);
  244.          seek(dialfile,dialarray_number);
  245.          write(dialfile,dial_dir);
  246.       end;
  247.    end;
  248.  
  249. (****************************************************************************)
  250. (*                         DELETE DIRECTORY ENTRY                           *)
  251. (****************************************************************************)
  252.    procedure
  253.       delete_dial_entry;
  254.    var
  255.       i,j    : integer;
  256.    begin
  257.       mkwin(41,1,71,5,'Delete');
  258.       writeln;
  259.       write(' Enter the # to delete: ');
  260.       readln(i);
  261.       rmwin;
  262.       j := i - (dialarray_number * max_dial_entries);
  263.       i := j;
  264.       if ( i > 0 ) and ( i <= max_dial_entries ) then begin
  265.          with dial_dir do begin
  266.             while i < no_of_dial_entries do begin
  267.                dir_entries[i] := dir_entries[i+1];
  268.                i := i + 1;
  269.             end;
  270.             no_of_dial_entries := no_of_dial_entries - 1;
  271.             paint_directory_screen(j);
  272.             seek(dialfile,dialarray_number);
  273.             write(dialfile,dial_dir);
  274.          end;
  275.       end;
  276.    end;
  277.  
  278. (****************************************************************************)
  279. (*                                DIALER                                    *)
  280. (****************************************************************************)
  281.    procedure
  282.       dialer;
  283.    var
  284.       i  : byte;
  285.    begin
  286.       for i:=1 to length( dial_str ) do begin
  287.          case dial_str[i] of
  288.              '|' : store_sout_buffer( CR );
  289.              '~' : delay( a_second );
  290.          else
  291.             store_sout_buffer( dial_str[i] );
  292.          end;
  293.       end;
  294.    end;
  295.  
  296. (****************************************************************************)
  297. (*                           MANUAL DIAL MODEM                              *)
  298. (****************************************************************************)
  299.    procedure
  300.       manual_dial;
  301.    begin
  302.       mkwin(25,1,71,5,'Manual Dial');
  303.       writeln;
  304.       write(' Enter Phone Number: ');
  305.       readln(dial_str);
  306.       dial_str := dial_pre_str + dial_str + dial_post_str;
  307.       redial_number := dial_str;
  308.       change_comm_params;
  309.       redial_name := '';
  310.       dialer;
  311.       dial_time := time;
  312.       initialize_music;
  313.       rmwin;
  314.    end;
  315.  
  316. (****************************************************************************)
  317. (*                            AUTO DIAL MODEM                               *)
  318. (****************************************************************************)
  319.    procedure
  320.       auto_dial;
  321.    var
  322.       i        : integer;
  323.    begin
  324.       mkwin(41,1,71,5,'Auto Dial');
  325.       writeln;
  326.       write(' Enter the # to dial: ');
  327.       readln(i);
  328.       i := i - (dialarray_number * max_dial_entries);
  329.       if ( I > 0 ) and ( i <= max_dial_entries ) then begin
  330.          with dial_dir.dir_entries[i] do begin
  331.             baud := bbs_baud;
  332.             stopbits := bbs_stopbits;
  333.             databits := bbs_databits;
  334.             par := bbs_parity;
  335.             setserial(baud,stopbits,databits,par);
  336.             dial_str := dial_pre_str + bbs_number + dial_post_str;
  337.             redial_number := dial_str;
  338.             redial_name := bbs_name;
  339.             dialer;
  340.             dial_time := time;
  341.             initialize_music;
  342.          end;
  343.       end
  344.       else begin
  345.          writeln(' Number must be on screen.');
  346.          wait_for_key;
  347.       end;
  348.       rmwin;
  349.    end;
  350.  
  351. (****************************************************************************)
  352. (*                             PAGE FORWARD                                 *)
  353. (****************************************************************************)
  354.    procedure
  355.       page_forward;
  356.    var
  357.       fsize : integer;
  358.    begin
  359.       fsize := filesize(dialfile) - 1;
  360.       if dialarray_number = fsize then exit;
  361.       dialarray_number := dialarray_number + 1;
  362.       seek(dialfile,dialarray_number);
  363.       read(dialfile,dial_dir);
  364.       paint_directory_screen(1);
  365.    end;
  366.  
  367. (****************************************************************************)
  368. (*                             PAGE BACKWARD                                *)
  369. (****************************************************************************)
  370.    procedure
  371.       page_backward;
  372.    begin
  373.       if dialarray_number = 0 then exit;
  374.       dialarray_number := dialarray_number - 1;
  375.       seek(dialfile,dialarray_number);
  376.       read(dialfile,dial_dir);
  377.       paint_directory_screen(1);
  378.    end;
  379.  
  380. (****************************************************************************)
  381. (*                           DIRECTORY MANAGER                              *)
  382. (****************************************************************************)
  383.    procedure
  384.       directory_manager;
  385.    begin
  386.       gotoxy(30,1);
  387.       writeln('Phone Directory');
  388.       writeln('  #         BBS Name                     Phone Number             Baud P D S');
  389.       writeln(' -- ------------------------------ ------------------------------ ---- - - -');
  390.       paint_directory_screen(1);
  391.       writeln;
  392.       write(' A=Add, C=Chg, K=Kill, M=M.Dial, D=A.Dial, S=Stop, F=PgFwd, B=PgBak, Q=Quit');
  393.       delay( a_second );
  394.       repeat
  395.          gotoxy(77,21);
  396.          kbd_char := ' ';
  397.          if keypressed then begin
  398.             read(kbd,kbd_char);
  399.             kbd_char := upcase(kbd_char);
  400.             case kbd_char of
  401.                'A' : add_dial_entry;
  402.                'C' : change_dial_entry;
  403.                'K' : delete_dial_entry;
  404.                'M' : manual_dial;
  405.                'G','D'
  406.                    : auto_dial;
  407.                'S' : store_sout_buffer(' ');
  408.                'F' : page_forward;
  409.                'B' : page_backward;
  410.                'Q' : ;
  411.             end;
  412.          end;
  413.          if (( port[modem_status_reg] and $80 ) <> 0)
  414.             and (forced_carrier[1] = 'F') then
  415.                kbd_char := 'Q';
  416.       until kbd_char = 'Q';
  417.    end;
  418.  
  419. (****************************************************************************)
  420. (*                             MODEM DIALER                                 *)
  421. (****************************************************************************)
  422.    procedure
  423.       dial_modem;
  424.    begin
  425.       dial_str := speaker_on;
  426.       dialer;
  427.       delay( wait_increment );
  428.       mkwin(1,1,80,23,'');
  429.       assign(dialfile,dial_PATH+'TMODEM.DIR');
  430.       {$I-};
  431.       reset(dialfile);
  432.       {$I+}
  433.       ok := (ioresult = 0);
  434.       dialarray_number := 0;
  435.       with dial_dir do begin
  436.          if ok then
  437.             read(dialfile,dial_dir)
  438.          else begin
  439.             no_of_dial_entries := 0;
  440.             rewrite(dialfile);
  441.             write(dialfile,dial_dir);
  442.             close(dialfile);
  443.             assign(dialfile,dial_PATH+'TMODEM.DIR');
  444.             reset(dialfile);
  445.             read(dialfile,dial_dir);
  446.          end;
  447.          directory_manager;
  448.          close(dialfile);
  449.       end;
  450.       rmwin;
  451.    end;
  452.  
  453. (****************************************************************************)
  454. (*                           HANG UP THE MODEM                              *)
  455. (****************************************************************************)
  456.    procedure
  457.       hang_up;
  458.    begin
  459.       mkwin(10,8,71,14,'');
  460.       gotoxy(23,3);
  461.       write('Hanging Up');
  462.       gotoxy(60,5);
  463.       port[modem_control_reg] := 0;
  464.       ascii_mode := false;
  465.       delay( a_second * 4 );
  466.       setserial(baud,stopbits,databits,par);
  467.       initialize_music;
  468.       sin_store_ptr := sin_read_ptr;
  469.       sout_store_ptr := sout_read_ptr;
  470.       dial_str := modem_init_str;
  471.       dialer;
  472.       rmwin;
  473.       writeln;
  474.    end;
  475.  
  476. (****************************************************************************)
  477. (*                            REDIAL THE MODEM                              *)
  478. (****************************************************************************)
  479.    procedure
  480.       redial_modem;
  481.    var
  482.       m            : integer;
  483.       i,j          : integer;
  484.       dt           : integer;
  485.       stop_dialing : boolean;
  486.    begin
  487.       if redial_number = '' then exit;
  488.       mkwin(10,6,71,16,'');
  489.       if forced_carrier[1] = 'T' then begin
  490.          gotoxy(26,3);
  491.          write('Redialing');
  492.       end
  493.       else begin
  494.          gotoxy(18,3);
  495.          write('Redialing Every ',redial_time,' Seconds');
  496.       end;
  497.       m := ( 60 - length( redial_name ) ) div 2 + 1;
  498.       gotoxy(m,5);
  499.       write( redial_name );
  500.       gotoxy(16,9);
  501.       write('Press any key to stop dialing... ');
  502.       dt := a_second div 20;
  503.       if forced_carrier[1] = 'T' then
  504.          stop_dialing := true
  505.       else begin
  506.          stop_dialing := false;
  507.          dial_str := speaker_off;
  508.          dialer;
  509.       end;
  510.       delay( 2 * a_second );
  511.       initialize_music;
  512.       dial_str := redial_number;
  513.       repeat
  514.          dialer;
  515.          dial_time := time;
  516.          i := redial_time + carrier_timeout + 1;
  517.          while ( i > 1 ) and ( not stop_dialing ) do begin
  518.             i := i - 1;
  519.             if i = redial_time then store_sout_buffer(' ');
  520.             gotoxy(55,9);
  521.             if i <= redial_time then
  522.                write(i:4)
  523.             else
  524.                clreol;
  525.             j := 0;
  526.             while ( j < 20 ) and ( not stop_dialing ) do begin
  527.                j := j + 1;
  528.                if keypressed then begin
  529.                   stop_dialing := true;
  530.                   read(kbd,kbd_char);
  531.                   store_sout_buffer(' ');
  532.                   delay( a_second );
  533.                   sin_read_ptr := sin_store_ptr;
  534.                end;
  535.                if ( port[modem_status_reg] and $80 ) <> 0 then begin
  536.                   delay( a_second );
  537.                   rmwin;
  538.                   sin_read_ptr := sin_store_ptr;
  539.                   writeln(CR+'CONNECT'^G);
  540.                   exit;
  541.                end
  542.                else
  543.                   delay( dt );
  544.             end;
  545.          end;
  546.       until stop_dialing;
  547.       rmwin;
  548.    end;
  549.  
  550. (****************************************************************************)
  551. (*                        ASCII FILE TRANSMISSION                           *)
  552. (****************************************************************************)
  553.    procedure
  554.       ascii_transmission;
  555.    var
  556.       image_cnt   : integer;
  557.    begin
  558.       mkwin(15,4,62,13,'Transmit ASCII File');
  559.       image_cnt := 0;
  560.       continue_transfer := true;
  561.       repeat
  562.          write(' Enter Filename to Transmit: ');
  563.          readln(filename);
  564.          if length(filename)=0 then begin
  565.             rmwin;
  566.             exit;
  567.          end;
  568.          assign(textfile,filename);
  569.          {$I-}
  570.          reset(textfile);
  571.          {$I+}
  572.          ok:=(ioresult = 0);
  573.          if not ok then
  574.             writeln(' Cannot find file: ',filename);
  575.       until ok;
  576.       ascii_mode := true;
  577.       gotoxy(1,2);
  578.       clreol;
  579.       writeln;
  580.       writeln('             Lines Transmitted');
  581.       writeln('             -----------------');
  582.       clreol;
  583.       while ( not eof(textfile) ) and continue_transfer do begin
  584.          readln(textfile,textimage);
  585.          image_cnt := image_cnt + 1;
  586.          gotoxy(19,5);
  587.          writeln(image_cnt:5);
  588.          xmit_data(textimage+CRLF);
  589.       end;
  590.       xmit_data(^Z^K);
  591.       close(textfile);
  592.       writeln;
  593.       write(' Waiting for buffer to drain...');
  594.       repeat until sout_store_ptr = sout_read_ptr;
  595.       ascii_mode := false;
  596.       sin_read_ptr := sin_store_ptr;          { Flush the buffer! }
  597.       rmwin;
  598.    end;
  599.  
  600. (****************************************************************************)
  601. (*                               VIEW FILE                                  *)
  602. (****************************************************************************)
  603.    procedure
  604.       view_file;
  605.    var
  606.       cnt       : byte;
  607.       wlabel    : labeltype;
  608.    begin
  609.       mkwin(33,4,77,10,'View File');
  610.       gotoxy(1,3);
  611.       repeat
  612.          write(' Enter Filename to View: ');
  613.          readln(filename);
  614.          if length(filename)=0 then begin
  615.             rmwin;
  616.             exit;
  617.          end;
  618.          assign(textfile,filename);
  619.          {$I-}
  620.          reset(textfile);
  621.          {$I+}
  622.          ok:=(ioresult = 0);
  623.          if not ok then
  624.             writeln(' Cannot find file: ',filename);
  625.       until ok;
  626.       rmwin;
  627.       wlabel := 'View File [' + filename + '],  <End> To Stop.';
  628.       mkwin(1,1,80,24,wlabel);
  629.       cnt := -5;
  630.       a_key := ' ';
  631.       while ( not eof(textfile) )
  632.          and  ( a_key[1] <> #207 )
  633.       do begin
  634.          readln(textfile,textimage);
  635.          if length(textimage) <= 77 then
  636.             writeln(textimage)
  637.          else
  638.             write(copy(textimage,1,78));
  639.          cnt := cnt + 1;
  640.          if cnt = 16 then begin
  641.             cnt:=0;
  642.             write(' <<< MORE >>> ');
  643.             repeat
  644.                a_key := inkey;
  645.             until a_key <> '';
  646.             if length(a_key)>1 then
  647.                a_key := chr(ord(a_key[2])+128);
  648.             gotoxy(1,wherey);
  649.             clreol;
  650.          end;
  651.       end;
  652.       close(textfile);
  653.       if ( cnt > 0 )
  654.          and ( a_key[1] <> #207 )
  655.       then begin
  656.          writeln;
  657.          wait_for_key;
  658.       end;
  659.       rmwin;
  660.    end;
  661.  
  662. (****************************************************************************)
  663. (*                       ENTER / LEAVE  HALF DUPLEX                         *)
  664. (****************************************************************************)
  665.    procedure
  666.       toggle_duplex;
  667.    begin
  668.       if half_duplex then begin
  669.          half_duplex := false;
  670.          clear_pos(79,25);
  671.       end
  672.       else begin
  673.          escape_win;
  674.          half_duplex := true;
  675.          gotoxy(79,25);
  676.          write('H');
  677.          reset_win;
  678.       end;
  679.    end;
  680.  
  681. (****************************************************************************)
  682. (*                      CHANGE DIRECTORY AND DISK DRIVE                     *)
  683. (****************************************************************************)
  684.    procedure
  685.       new_directory_drive;
  686.    var
  687.       dd     : char;
  688.       dn     : integer;
  689.       curdir : string80;
  690.       dstr   : string[10];
  691.    begin
  692.       mkwin(12,4,69,12,'Change Directory\Drive');
  693.       dd:=default_drive;
  694.       dn:=ord(dd)-ord('A')+1;
  695.       getdir(dn,curdir);
  696.       writeln;
  697.       writeln(' Current Drive\Directory: ',curdir);
  698.       writeln;
  699.       write(' Enter New Drive Letter : ');
  700.       readln(dstr);
  701.       if length(dstr)>0 then begin
  702.          dd:=upcase(dstr[1]);
  703.          if not (dd in [ 'A'..'D' ]) then
  704.             dd:='A';
  705.          change_drive(dd);
  706.       end;
  707.       repeat
  708.          write('     Enter New Directory: ');
  709.          readln(curdir);
  710.          {$I-}
  711.          if length(curdir)>0 then begin
  712.             chdir(curdir);
  713.             ok:=(ioresult = 0);
  714.             if not ok then
  715.                writeln(' Can''t access that directory!');
  716.          end;
  717.          {$I+}
  718.       until ( ok )  or  ( length( curdir ) = 0 );
  719.       rmwin;
  720.    end;
  721.  
  722. (****************************************************************************)
  723. (*                               KILL FILE                                  *)
  724. (****************************************************************************)
  725.    procedure
  726.       kill_file;
  727.    begin
  728.       mkwin(33,4,77,10,'Kill File');
  729.       gotoxy(1,3);
  730.       repeat
  731.          write(' Enter Filename to Kill: ');
  732.          readln(filename);
  733.          if length(filename)=0 then begin
  734.             rmwin;
  735.             exit;
  736.          end;
  737.          assign(textfile,filename);
  738.          {$I-}
  739.          erase(textfile);
  740.          {$I+}
  741.          ok:=(ioresult = 0);
  742.          if not ok then
  743.             writeln(' Cannot kill file: ',filename);
  744.       until ok;
  745.       rmwin;
  746.    end;
  747.  
  748. (****************************************************************************)
  749. (*                         REWRITE DIAL ENTRIES                             *)
  750. (****************************************************************************)
  751.    procedure
  752.       rewrite_dial_entries;
  753.    begin
  754.       rewrite(dialfile);
  755.       sort_curr := sort_first;
  756.       dial_dir.no_of_dial_entries := 0;
  757.       while sort_curr <> nil do begin
  758.          dial_dir.no_of_dial_entries := dial_dir.no_of_dial_entries + 1;
  759.          dial_dir.dir_entries[dial_dir.no_of_dial_entries] := sort_curr^.sort_rec;
  760.          if dial_dir.no_of_dial_entries = max_dial_entries then begin
  761.             write(dialfile,dial_dir);
  762.             dial_dir.no_of_dial_entries := 0;
  763.          end;
  764.          sort_first := sort_curr;
  765.          sort_curr := sort_curr^.sort_next;
  766.          dispose(sort_first);
  767.       end;
  768.       if dial_dir.no_of_dial_entries > 0 then
  769.          write(dialfile,dial_dir);
  770.    end;
  771.  
  772. (****************************************************************************)
  773. (*                           SORT DIAL ENTRIES                              *)
  774. (****************************************************************************)
  775.    procedure
  776.       sort_dial_entries( typ : integer );
  777.    var
  778.       flg      : boolean;
  779.       hold_rec : dialrec;
  780.       swap     : boolean;
  781.    begin
  782.       repeat
  783.          flg := false;
  784.          sort_curr := sort_first;
  785.          sort_prev := sort_curr^.sort_next;
  786.          while sort_prev <> nil do begin
  787.             swap := false;
  788.             case typ of
  789.                1 : begin
  790.                       if sort_curr^.sort_rec.bbs_name > sort_prev^.sort_rec.bbs_name then
  791.                          swap := true;
  792.                    end;
  793.                2 : begin
  794.                       if sort_curr^.sort_rec.bbs_number > sort_prev^.sort_rec.bbs_number then
  795.                          swap := true;
  796.                    end;
  797.             end;
  798.             if swap then begin
  799.                flg := true;
  800.                hold_rec := sort_prev^.sort_rec;
  801.                sort_prev^.sort_rec := sort_curr^.sort_rec;
  802.                sort_curr^.sort_rec := hold_rec;
  803.             end;
  804.             sort_curr := sort_curr^.sort_next;
  805.             sort_prev := sort_prev^.sort_next;
  806.          end;
  807.       until not flg;
  808.    end;
  809.  
  810. (****************************************************************************)
  811. (*                           LOAD DIAL ENTRIES                              *)
  812. (****************************************************************************)
  813.    procedure
  814.       load_dial_entries( fs  :  integer );
  815.    var
  816.       i,j   : integer;
  817.    begin
  818.       new(sort_first);
  819.       sort_curr := sort_first;
  820.       for i:=0 to fs do begin
  821.          seek(dialfile,i);
  822.          read(dialfile,dial_dir);
  823.          for j:=1 to dial_dir.no_of_dial_entries do begin
  824.             sort_curr^.sort_rec := dial_dir.dir_entries[j];
  825.             new(sort_curr^.sort_next);
  826.             sort_prev := sort_curr;
  827.             sort_curr := sort_curr^.sort_next;
  828.          end;
  829.       end;
  830.       dispose(sort_curr);
  831.       sort_prev^.sort_next := nil;
  832.    end;
  833.  
  834. (****************************************************************************)
  835. (*                         SORT DIALING DIRECTORY                           *)
  836. (****************************************************************************)
  837.    procedure
  838.       sort_dialing_directory;
  839.    var
  840.       fsize   : integer;
  841.       typ     : integer;
  842.    begin
  843.       mkwin(8,4,73,12,'Phone Directory Sort Type');
  844.       gotoxy(10,2);
  845.       write('1.  Sort Into Ascending Sequence By Name.');
  846.       gotoxy(10,4);
  847.       write('2.  Sort Into Ascending Sequence By Number.');
  848.       gotoxy(10,7);
  849.       write('Which do you want? ');
  850.       typ := 0;
  851.       read(typ);
  852.       if not (typ in [ 1..2 ]) then
  853.          typ := 1;
  854.       rmwin;
  855.       mkwin(10,5,71,11,'');
  856.       gotoxy(23,3);
  857.       write('S O R T I N G ');
  858.       assign(dialfile,dial_PATH+'TMODEM.DIR');
  859.       {$I-}
  860.       reset(dialfile);
  861.       {$I+}
  862.       ok := (ioresult = 0);
  863.       if ok then begin
  864.          fsize := filesize(dialfile);
  865.          if fsize > 0 then begin
  866.             load_dial_entries( fsize - 1 );
  867.             sort_dial_entries(typ);
  868.             rewrite_dial_entries;
  869.             close(dialfile);
  870.          end;
  871.       end;
  872.       rmwin;
  873.    end;
  874.  
  875. (****************************************************************************)
  876. (*                             SEND FUNCTION KEY                            *)
  877. (****************************************************************************)
  878.    procedure
  879.       send_func_key( j : integer );
  880.    var
  881.       i             : byte;
  882.       end_of_key    : boolean;
  883.    begin
  884.       i := 0;
  885.       end_of_key := false;
  886.       while ( i < length(func_key^[j]) ) and ( not end_of_key ) do begin
  887.          i := i + 1;
  888.          case func_key^[j][i] of
  889.             '|' : store_sout_buffer( CR );
  890.             '~' : delay( a_second );
  891.             ';' : end_of_key := true;
  892.          else
  893.             store_sout_buffer( func_key^[j][i] );
  894.          end;
  895.       end;
  896.    end;
  897.  
  898. (****************************************************************************)
  899. (*                           MACRO KEY MAINTENANCE                          *)
  900. (****************************************************************************)
  901.    procedure
  902.       display_keys( Fn : integer );
  903.    var
  904.       i    : byte;
  905.    begin
  906.       gotoxy(2,2);
  907.       clreol;
  908.       case Fn of
  909.           1 : writeln('< Unshifted >');
  910.          11 : writeln('< Shifted >');
  911.          21 : writeln('< Ctrl >');
  912.          31 : writeln('< Alt >');
  913.       end;
  914.       writeln;
  915.       for i:=1 to 10 do begin
  916.          clreol;
  917.          writeln(i:3,'.  ',func_key^[i+Fn-1]);
  918.       end;
  919.    end;
  920.  
  921.    procedure
  922.       page_func_fwd(var Fn : integer);
  923.    begin
  924.       Fn := Fn + 10;
  925.       if Fn > 40 then Fn := Fn - 40;
  926.       display_keys(Fn);
  927.    end;
  928.  
  929.    procedure
  930.       page_func_bak(var Fn : integer);
  931.    begin
  932.       Fn := Fn - 10;
  933.       if Fn < 1 then Fn := Fn + 40;
  934.       display_keys(Fn);
  935.    end;
  936.  
  937.    procedure
  938.       macro_keys;
  939.    var
  940.       i      : integer;
  941.       flg    : boolean;
  942.       Fn     : integer;
  943.    begin
  944.       flg := false;
  945.       mkwin(1,3,80,20,'Function Keys. Use:  | for CR,  ~ for delay,  ; for comment.');
  946.       Fn := 1;
  947.       display_keys(Fn);
  948.       gotoxy(1,16);
  949.       write(' Enter: C=Chg, F=PgFwd, B=PgBak, Q=Quit. ');
  950.       repeat
  951.          gotoxy(42,16);
  952.          clreol;
  953.          repeat
  954.             a_key := inkey;
  955.          until a_key <> '';
  956.          kbd_char := upcase( a_key[1] );
  957.          case kbd_char of
  958.             'C' : begin
  959.                      write(' Which One? ');
  960.                      read(i);
  961.                      if ( i > 0 ) and ( i < 11 ) then begin
  962.                         flg := true;
  963.                         gotoxy(7,i+3);
  964.                         str_input(func_key^[i+Fn-1]);
  965.                      end;
  966.                   end;
  967.             'F' : page_func_fwd(Fn);
  968.             'B' : page_func_bak(Fn);
  969.          end;
  970.       until kbd_char = 'Q';
  971.       if flg then begin
  972.          assign(textfile,cnf_PATH+'TMODEM.KEY');
  973.          rewrite(textfile);
  974.          for i:=1 to 40 do writeln(textfile,func_key^[i]);
  975.          close(textfile);
  976.       end;
  977.       rmwin;
  978.    end;
  979.  
  980. (****************************************************************************)
  981. (*                          EXECUTE KEYBOARD COMMAND                        *)
  982. (****************************************************************************)
  983.    procedure
  984.       underscore;
  985.    begin
  986.       gotoxy(13,wherey);
  987.       write('--------');
  988.       gotoxy(24,wherey);
  989.       writeln('--------');
  990.    end;
  991.    procedure
  992.       exec_command;
  993.    var
  994.       hold_mode   : boolean;
  995.    begin
  996.       case ch of
  997.          #46 : toggle_capture_mode;
  998.          #20 : begin
  999.                   mkwin(57,18,78,22,'');
  1000.                   writeln;
  1001.                   write(' Exit Program? ');
  1002.                   readln(yes_no);
  1003.                   yes_no := upcase( yes_no[1] );
  1004.                   if yes_no = 'Y' then exit_program := true;
  1005.                   rmwin;
  1006.                end;
  1007.          #31 : change_comm_params;
  1008.          #19 : receive_file;
  1009.          #45 : transmit_file;
  1010.          #32 : dial_modem;
  1011.          #18 : toggle_duplex;
  1012.          #35 : give_help;
  1013.          #23 : reconfigure_defaults;
  1014.          #30 : ascii_transmission;
  1015.          #16 : hang_up;
  1016.          #38 : dir_list;
  1017.          #49 : new_directory_drive;
  1018.          #47 : view_file;
  1019.          #37 : kill_file;
  1020.          #34 : redial_modem;
  1021.          #50 : macro_keys;
  1022.          #24 : sort_dialing_directory;
  1023.          #17 : clrscr;
  1024.          #21 : copy_file;
  1025.          #72 : send_str( ^['[A' );
  1026.          #80 : send_str( ^['[B' );
  1027.          #77 : send_str( ^['[C' );
  1028.          #75 : send_str( ^['[D' );
  1029.          #83 : store_sout_buffer( #127 );
  1030.          #44 : begin
  1031.                   if monitor_mode then
  1032.                      monitor_mode := false
  1033.                   else
  1034.                      monitor_mode := true;
  1035.                end;
  1036.         #114 : begin
  1037.                   if printer_on then
  1038.                      printer_on:=false
  1039.                   else
  1040.                      printer_on:=true;
  1041.                end;
  1042.          #25 : begin
  1043.                   hold_mode := silent_mode;
  1044.                   silent_mode := false;
  1045.                   music_box;
  1046.                   silent_mode := hold_mode;
  1047.                end;
  1048.          #33 : begin
  1049.                   time_fix := time+' ';
  1050.                   writeln(CRLF+'Time Fix :  ',time_fix);
  1051.                end;
  1052.          #22 : begin
  1053.                   writeln;
  1054.                   gotoxy(13,wherey);
  1055.                   write('Time Fix');
  1056.                   gotoxy(24,wherey);
  1057.                   writeln('Session');
  1058.                   underscore;
  1059.                   write('Starting :  ',time_fix);
  1060.                   gotoxy(24,wherey);
  1061.                   writeln(dial_time);
  1062.                   curr_time := time+' ';
  1063.                   write('Current  :  ',curr_time);
  1064.                   gotoxy(24,wherey);
  1065.                   writeln(curr_time);
  1066.                   underscore;
  1067.                   write('Used     :  ',delta_time(time_fix,curr_time));
  1068.                   gotoxy(24,wherey);
  1069.                   writeln(delta_time(dial_time,curr_time));
  1070.                end;
  1071.       else
  1072.          if ch in [ #59..#68 ] then
  1073.             send_func_key( ord(ch) - 58 )
  1074.          else
  1075.             if ch in [ #84..#113 ] then
  1076.                send_func_key( ord(ch) - 73 );
  1077.       end;
  1078.    end;